home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue71 / Stack / FastObjects.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-19  |  3.9 KB  |  138 lines
  1. unit FastObjects;
  2.  
  3. interface
  4.  
  5. type
  6.   TInteger = class
  7.   private
  8.     FValue : Integer;
  9.   public
  10.     // Just calls DoCreate
  11.     constructor Create( value : Integer );
  12.     // Just calls DoDestroy
  13.     destructor  Destroy; override;
  14.     property    Value : Integer read FValue write FValue;
  15.   protected
  16.     // Performs all operations for Create, except allocating memory
  17.     procedure   DoCreate( value : Integer ); virtual;
  18.     // Performs all operations for Destroy, except freeing memory
  19.     procedure   DoDestroy; virtual;
  20.   end;
  21.  
  22.   TIntegerRec = record
  23.     // This is just for the VMT all object have at the beginning
  24.     _VMT : TClass;
  25.     // The following members must have exactly the same size that
  26.     // all members in TInteger have: this is easily accomplished by
  27.     // copying all members in TInteger
  28.     _FValue : Integer;
  29.   end;
  30.  
  31.   TFastIntegerRec = record
  32.     // This is just for the VMT all object have at the beginning
  33.     _VMT : TClass;
  34.     // The following members must have exactly the same size that
  35.     // all members in TInteger have: this is easily accomplished by
  36.     // copying all members in TInteger
  37.     _FValue : Integer;
  38.   end;
  39.  
  40. // Equivalent to TInteger.Create, but uses the memory provided by rec,
  41. // so that a TIntegerRec in the stack can be used
  42. function  CreateObject( var rec : TIntegerRec; value : Integer ): TInteger; overload;
  43. // Returns the TInteger allocated in rec: note that Create(rec, value)
  44. // must have been called previously.
  45. function  GetObject( const rec : TIntegerRec ): TInteger; overload;
  46. // Subsitutes GetObject(rec).Free. In fact, this can't be called
  47. // because it would call FreeMem(@rec), which is not a good idea!
  48. procedure FreeObject( var rec : TIntegerRec ); overload;
  49.  
  50. function  CreateObject( var rec : TFastIntegerRec; value : Integer ): TInteger; overload;
  51. procedure FreeObject( var rec : TFastIntegerRec ); overload;
  52. function  GetObject( const rec : TFastIntegerRec ): TInteger; overload;
  53.  
  54. implementation
  55.  
  56. function CreateObject( var rec : TIntegerRec; value : Integer ): TInteger;
  57. begin
  58.   TInteger.InitInstance(@rec);
  59.   Result := GetObject(rec);
  60.   // We provide exactly the same semantics for Create(rec,value) as
  61.   // for TInteger.Create(value): that means that the "destructor" must
  62.   // be called if creation fails. Since DoCreate does all what Create
  63.   // does, except memory allocation, and DoDestroy performs all what
  64.   // Destroy does, except memory deallocation, we call them.
  65.   try
  66.     Result.DoCreate( value );
  67.     Result.AfterConstruction;
  68.   except
  69.     Result.DoDestroy;
  70.     Result.CleanupInstance;
  71.     raise;
  72.   end;
  73. end;
  74.  
  75. procedure FreeObject( var rec : TIntegerRec );
  76. var
  77.   obj : TInteger;
  78. begin
  79.   obj := GetObject(rec);
  80.   obj.BeforeDestruction;
  81.   obj.DoDestroy;
  82.   obj.CleanupInstance;
  83. end;
  84.  
  85. function  GetObject( const rec : TIntegerRec ): TInteger;
  86. begin
  87.   Result := TInteger(@rec);
  88. end;
  89.  
  90. function CreateObject( var rec : TFastIntegerRec; value : Integer ): TInteger;
  91. begin
  92.   rec._VMT := TInteger;
  93.   Result := TInteger(@rec);
  94.   Result.FValue := value;
  95. end;
  96.  
  97. procedure FreeObject( var rec : TFastIntegerRec ); overload;
  98. begin
  99. end;
  100.  
  101. function  GetObject( const rec : TFastIntegerRec ): TInteger;
  102. begin
  103.   Result := TInteger(@rec);
  104. end;
  105.  
  106. { TInteger }
  107.  
  108. constructor TInteger.Create(value: Integer);
  109. begin
  110.   DoCreate( value );
  111. end;
  112.  
  113. procedure TInteger.DoCreate(value: Integer);
  114. begin
  115.   FValue := value;
  116. end;
  117.  
  118. destructor TInteger.Destroy;
  119. begin
  120.   DoDestroy;
  121. end;
  122.  
  123. procedure TInteger.DoDestroy;
  124. begin
  125.   // Ok, we do nothing, but this is needed for demonstration purposes;
  126. end;
  127.  
  128. {$ifdef DEBUG}
  129. initialization
  130.   // Check that TIntegerRec has exactly the same size as a TInteger
  131.   // instance
  132.   Assert( SizeOf( TIntegerRec ) = TInteger.InstanceSize );
  133.   // Check that TFastIntegerRec has exactly the same size as a TInteger
  134.   // instance
  135.   Assert( SizeOf( TFastIntegerRec ) = TInteger.InstanceSize );
  136. {$endif} // DEBUG
  137. end.
  138.